home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1995 October
/
EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso
/
Aminet
/
util
/
cdity
/
cx22.lha
/
CX2.2
/
Quelltext
/
CXARexx.mod
< prev
next >
Wrap
Text File
|
1995-04-26
|
11KB
|
386 lines
IMPLEMENTATION MODULE CXARexx;
(* CXARexx.mod - ARexx-Routinen
* Version : $VER: CXARexx.mod 2.0 (© 1995 Fin Schuppenhauer)
* Autor : Fin Schuppenhauer
* Braußpark 10
* 20537 Hamburg
* (Germany)
* E-Mail : 1schuppe@informatik.uni-hamburg.de
* Erstellt am : 21 Mar 1995
* Letzte Änd. : 26 Apr 1995
*)
IMPORT
rd:RexxD, rl:RexxL,
ed:ExecD, el:ExecL, es:ExecSupport,
dd:DosD, dl:DosL,
cd:CommoditiesD, cp:CommoditiesPrivate,
id:IntuitionD, il:IntuitionL,
ll:LocaleL,
str:String,
cxc:CXCommodity,
cxl:CXLokal,
cxf:CXFileIO,
cxw:CXWindow;
FROM SYSTEM IMPORT
ADR, ADDRESS, CAST, LONGSET;
CONST
PORTNAME = "CX";
cxName = "Exchange";
(* Templates der einzelen Kommandos: *)
TMPL_QUIT = "";
TMPL_QUERY = "BROKER/K";
TMPL_ENABLE = "BROKER/K,ALL/S";
TMPL_DISABLE = "BROKER/K,ALL/S";
TMPL_SHOW = "BROKER/K";
TMPL_HIDE = "BROKER/K";
TMPL_REMOVE = "BROKER/K,REMOVELIST/K,ALL/S,FORCE/S";
TMPL_GETLIST = "";
TYPE
ARexxCommands = (UNKNOWN, QUIT, QUERY, ENABLE, DISABLE, SHOW, HIDE, REMOVE, GETLIST);
ARexxProcedure = PROCEDURE (VAR LONGINT, VAR LONGINT, BOOLEAN, dd.RDArgsPtr);
String = ARRAY [0..127] OF CHAR;
StrPtr = POINTER TO String;
VAR
arexxport: ed.MsgPortPtr;
arexxproc: ARRAY ARexxCommands OF ARexxProcedure;
PROCEDURE InitARexx(): BOOLEAN;
BEGIN
arexxport := es.CreatePort(ADR(PORTNAME),0);
IF arexxport # NIL THEN
arexxsignal := arexxport^.sigBit;
RETURN TRUE;
END;
RETURN FALSE;
END InitARexx;
PROCEDURE FreeARexx;
BEGIN
IF arexxport # NIL THEN
es.DeletePort (arexxport);
arexxport := NIL;
END;
END FreeARexx;
(* --------------------------------------------------------------- *)
PROCEDURE ExtractARexxCmd (arg0 : ARRAY OF CHAR;
VAR cmdLength : INTEGER) : ARexxCommands;
(** "Kommando aus Argumentstring extrahieren"
*)
VAR
command: String;
i: INTEGER;
BEGIN
i := 0;
WHILE (arg0[i] # " ") & (arg0[i] # 0C) DO
command[i] := arg0[i];
INC (i);
END;
command[i] := 0C;
cmdLength := str.Length(command) + 1;
IF str.Compare(command, "QUIT")=0 THEN RETURN QUIT;
ELSIF str.Compare(command, "QUERY")=0 THEN RETURN QUERY;
ELSIF str.Compare(command, "ENABLE")=0 THEN RETURN ENABLE;
ELSIF str.Compare(command, "DISABLE") = 0 THEN RETURN DISABLE;
ELSIF str.Compare(command, "SHOW") = 0 THEN RETURN SHOW;
ELSIF str.Compare(command, "HIDE") = 0 THEN RETURN HIDE;
ELSIF str.Compare(command, "REMOVE") = 0 THEN RETURN REMOVE;
ELSIF str.Compare(command, "GETLIST") = 0 THEN RETURN GETLIST;
ELSE RETURN UNKNOWN;
END;
END ExtractARexxCmd;
(* **)
PROCEDURE CheckTemplate (template: ARRAY OF CHAR;
VAR optionsArray: ADDRESS;
rdargs: dd.RDArgsPtr) : LONGINT;
(** "Template überprüfen" *)
VAR
success: dd.RDArgsPtr;
IoErrMsg: String;
easyreq : id.EasyStruct;
idcmp : id.IDCMPFlagSet;
num: LONGINT;
BEGIN
success := dl.ReadArgs(ADR(template), optionsArray, rdargs);
IF success = NIL THEN
IF dl.Fault(dl.IoErr(), NIL, ADR(IoErrMsg), 75) THEN
idcmp := id.IDCMPFlagSet{};
WITH easyreq DO
structSize := SIZE(id.EasyStruct);
flags := LONGSET{};
title := ll.GetCatalogStr(cxw.catalog, cxl.REQ_AREXX_TITLE, ADR(cxl.REQ_AREXX_TITLESTR));
textFormat := ADR(IoErrMsg);
gadgetFormat:= ll.GetCatalogStr(cxw.catalog, cxl.REQ_AREXX_FORMAT, ADR(cxl.REQ_AREXX_FORMATSTR));
END;
num := il.EasyRequestArgs(NIL, easyreq, idcmp, NIL);
END;
RETURN dd.error;
END;
RETURN dd.ok;
END CheckTemplate;
(* **)
PROCEDURE ClearOptionsArray (VAR array: ARRAY OF LONGINT;
count: INTEGER);
(** "Array für die Aufnahme der Optionen initialisieren" *)
BEGIN
DEC (count);
WHILE count >= 0 DO
array[count] := 0;
DEC (count);
END;
END ClearOptionsArray;
(* **)
(* ----- ARexx-Kommandos: ---------------------------------------- *)
PROCEDURE Quit (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
BEGIN
rs1 := dd.ok;
END Quit;
PROCEDURE Query (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
CONST
MAXOPTIONS = 1;
optBroker = 0;
VAR
options: ARRAY [0..MAXOPTIONS-1] OF LONGINT;
optArray: ADDRESS;
infostr: String;
cpb: cp.BrokerCopyPtr;
BEGIN
ClearOptionsArray (options, MAXOPTIONS);
optArray := ADR(options);
options[optBroker] := ADR(cxName);
rs1 := CheckTemplate(TMPL_QUERY, optArray, rdargs);
IF (rs1 = dd.ok) AND result THEN
cpb := cxc.GetBrokerCopyByName(CAST(cxc.StrPtr, options[optBroker]));
IF cpb # NIL THEN
IF cp.active IN cpb^.flags THEN
infostr := "active";
ELSE
infostr := "inactive";
END;
IF cp.showhide IN cpb^.flags THEN
str.Concat(infostr, " window");
ELSE
str.Concat(infostr, " nowindow");
END;
rs2 := CAST(LONGINT, rl.CreateArgstring(ADR(infostr), str.Length(infostr)));
ELSE
rs1 := dd.warn;
END;
END;
dl.FreeArgs (rdargs);
END Query;
PROCEDURE Enable (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
CONST
MAXOPTIONS = 2;
optBroker = 0;
optAll = 1;
VAR
options: ARRAY [0..MAXOPTIONS-1] OF LONGINT;
optArray: ADDRESS;
li: LONGINT;
BEGIN
ClearOptionsArray (options, MAXOPTIONS);
optArray := ADR(options);
options[optBroker] := ADR(cxName);
rs1 := CheckTemplate(TMPL_ENABLE, optArray, rdargs);
IF rs1 = dd.ok THEN
IF options[optAll] # 0 THEN
cxc.SendAllBrokerCommand(cd.cxcmdEnable);
ELSE
li := cp.BrokerCommand(options[optBroker], cd.cxcmdEnable);
END;
END;
dl.FreeArgs(rdargs);
END Enable;
PROCEDURE Disable (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
CONST
MAXOPTIONS = 2;
optBroker = 0;
optAll = 1;
VAR
options: ARRAY [0..MAXOPTIONS-1] OF LONGINT;
optArray: ADDRESS;
li: LONGINT;
BEGIN
ClearOptionsArray (options, MAXOPTIONS);
optArray := ADR(options);
options[optBroker] := ADR(cxName);
rs1 := CheckTemplate(TMPL_DISABLE, optArray, rdargs);
IF rs1 = dd.ok THEN
IF options[optAll] # 0 THEN
cxc.SendAllBrokerCommand (cd.cxcmdDisable);
ELSE
li := cp.BrokerCommand (options[optBroker], cd.cxcmdDisable);
END;
END;
dl.FreeArgs(rdargs);
END Disable;
PROCEDURE Show (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
CONST
MAXOPTIONS = 1;
optBroker = 0;
VAR
options: ARRAY [0..MAXOPTIONS-1] OF LONGINT;
optArray: ADDRESS;
li: LONGINT;
BEGIN
ClearOptionsArray (options, MAXOPTIONS);
optArray := ADR(options);
options[optBroker] := ADR(cxName);
rs1 := CheckTemplate(TMPL_SHOW, optArray, rdargs);
IF rs1 = dd.ok THEN
li := cp.BrokerCommand(options[optBroker], cd.cxcmdAppear);
END;
dl.FreeArgs(rdargs);
END Show;
PROCEDURE Hide (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
CONST
MAXOPTIONS = 1;
optBroker = 0;
VAR
options: ARRAY [0..MAXOPTIONS-1] OF LONGINT;
optArray: ADDRESS;
li: LONGINT;
BEGIN
ClearOptionsArray (options, MAXOPTIONS);
optArray := ADR(options);
options[optBroker] := ADR(cxName);
rs1 := CheckTemplate(TMPL_HIDE, optArray, rdargs);
IF rs1 = dd.ok THEN
li := cp.BrokerCommand(options[optBroker], cd.cxcmdDisappear);
END;
dl.FreeArgs(rdargs);
END Hide;
PROCEDURE Remove (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
CONST
MAXOPTIONS = 4;
optBroker = 0;
optRemoveList = 1;
optAll = 2;
optForce = 3;
VAR
options: ARRAY [0..MAXOPTIONS-1] OF LONGINT;
optArray: ADDRESS;
li: LONGINT;
BEGIN
ClearOptionsArray (options, MAXOPTIONS);
optArray := ADR(options);
rs1 := CheckTemplate(TMPL_REMOVE, optArray, rdargs);
IF rs1 = dd.ok THEN
IF options[optAll] # 0 THEN
IF options[optForce] # 0 THEN
cxc.SendAllBrokerCommand(cd.cxcmdKill);
ELSE
IF options[optRemoveList] # 0 THEN
cxf.FreeRemoveList;
cxf.LoadRemoveList (options[optRemoveList]);
END;
cxw.KillAll;
END;
ELSE
li := cp.BrokerCommand(options[optBroker], cd.cxcmdKill);
END;
END;
dl.FreeArgs(rdargs);
END Remove;
PROCEDURE GetList (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
VAR
infostr: String;
node: ed.NodePtr;
BEGIN
IF cxc.brokerlist # NIL THEN
infostr := "";
node := cxc.brokerlist^.head;
WHILE node^.succ # NIL DO
str.Concat (infostr, CAST(cp.BrokerCopyPtr, node)^.name);
str.ConcatChar (infostr, " ");
node := node^.succ;
END;
rs2 := CAST(LONGINT, rl.CreateArgstring(ADR(infostr), str.Length(infostr)));
ELSE
rs2 := CAST(LONGINT, rl.CreateArgstring(ADR("emptylist"), 9));
END;
END GetList;
PROCEDURE Unknown (VAR rs1, rs2: LONGINT; result: BOOLEAN; rdargs: dd.RDArgsPtr);
BEGIN
rs1 := dd.fail;
END Unknown;
(* --------------------------------------------------------------- *)
PROCEDURE HandleARexxMsg (VAR done: BOOLEAN);
VAR
msg: rd.RexxMsgPtr;
arg0: String;
cmd: ARexxCommands;
cmdLength: INTEGER;
rdargs: dd.RDArgsPtr;
result: BOOLEAN;
BEGIN
LOOP
msg := CAST(rd.RexxMsgPtr, el.GetMsg(arexxport));
IF msg = NIL THEN EXIT; END;
IF rl.IsRexxMsg(msg) THEN
str.Copy (arg0, CAST(StrPtr, msg^.args[0])^);
cmd := ExtractARexxCmd(arg0, cmdLength);
IF msg^.action.command = rd.comm THEN
result := rd.result IN msg^.action.modifier;
rdargs := dl.AllocDosObject(dd.dosRdArgs, NIL);
IF rdargs # NIL THEN
str.ConcatChar (arg0, "\n");
WITH rdargs^.source DO
buffer := ADR(arg0) + ADDRESS(cmdLength);
length := str.Length(CAST(StrPtr, buffer)^);
curChr := 0;
END;
arexxproc[cmd] (msg^.result1, msg^.result2, result, rdargs);
IF (cmd = QUIT) AND (msg^.result1 = dd.ok) THEN
done := TRUE;
END;
dl.FreeDosObject (dd.dosRdArgs, rdargs);
rdargs := NIL;
END;
END;
END;
el.ReplyMsg (msg);
END;
END HandleARexxMsg;
(* --------------------------------------------------------------- *)
BEGIN (* main *)
arexxproc[UNKNOWN] := Unknown;
arexxproc[QUIT] := Quit;
arexxproc[QUERY] := Query;
arexxproc[ENABLE] := Enable;
arexxproc[DISABLE] := Disable;
arexxproc[SHOW] := Show;
arexxproc[HIDE] := Hide;
arexxproc[REMOVE] := Remove;
arexxproc[GETLIST] := GetList;
END CXARexx.